Kaminda - Practical 2

knitr::opts_chunk$set(echo = TRUE)
library(readr)
library(dplyr)

library(tidyr)
library(ggplot2)
library(scales)

```r
install.packages(\tidytext\)
install.packages(\textstem\)
install.packages(\clinspacy\)
install.packages(\topicmodels\)
install.packages(\reshape2\)
install.packages(\stringr\)

<!-- rnb-source-end -->

<!-- rnb-chunk-end -->


<!-- rnb-text-begin -->



<!-- rnb-text-end -->


<!-- rnb-chunk-begin -->


<!-- rnb-source-begin eyJkYXRhIjoiYGBgclxubGlicmFyeSh0aWR5dGV4dClcbmxpYnJhcnkodGV4dHN0ZW0pXG5saWJyYXJ5KGNsaW5zcGFjeSlcbmxpYnJhcnkodG9waWNtb2RlbHMpXG5saWJyYXJ5KHJlc2hhcGUyKVxubGlicmFyeShzdHJpbmdyKVxuYGBgIn0= -->

```r
library(tidytext)
library(textstem)
library(clinspacy)
library(topicmodels)
library(reshape2)
library(stringr)

###Data Parsing

raw.data <- clinspacy::dataset_mtsamples()
dplyr::glimpse(raw.data)

Rows: 4,999
Columns: 6
$ note_id           <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, …
$ description       <chr> "A 23-year-old white female presents with complaint of allergies.", "Consult for laparoscopic g…
$ medical_specialty <chr> "Allergy / Immunology", "Bariatrics", "Bariatrics", "Cardiovascular / Pulmonary", "Cardiovascul…
$ sample_name       <chr> "Allergic Rhinitis", "Laparoscopic Gastric Bypass Consult - 2", "Laparoscopic Gastric Bypass Co…
$ transcription     <chr> "SUBJECTIVE:,  This 23-year-old white female presents with complaint of allergies.  She used to…
$ keywords          <chr> "allergy / immunology, allergic rhinitis, allergies, asthma, nasal sprays, rhinitis, nasal, ery…

1

###Data Description

##NoteID - This variable is the unique ID for each note.

##Description - This output provides a summary of the SOAP notes.

##Medical_Specialty - This variable refers to the medical speciality the patient is visiting.

##Sample_Name - This variable refers to the procedures undergone for each patient.

##Transcription - This output provides a full transcript of the physicians SOAP notes.

##Keywords - This output collects keywords from the Medical_Speciality, Sample_Name, and Transcription variables.

raw.data %>% dplyr::select(medical_specialty) %>% dplyr::n_distinct()

[1] 40

###Transcripts per specialty

ggplot2::ggplot(raw.data, ggplot2::aes(y=medical_specialty)) + ggplot2::geom_bar() + labs(x="Document Count", y="Medical Speciality")

filtered.data <- raw.data %>% dplyr::filter(medical_specialty %in% c("Orthopedic", "Radiology", "Surgery")) 

###Text Processing

analysis.data <- filtered.data %>%
  unnest_tokens(word, transcription) %>%
  mutate(word = str_replace_all(word, "[^[:alnum:]]", "")) %>%
  filter(!str_detect(word, "[0-9]")) %>%
  anti_join(stop_words) %>%
  group_by(note_id) %>%
  summarise(transcription = paste(word, collapse = " ")) %>%
  left_join(select(filtered.data, -transcription), by = "note_id")

Joining with `by = join_by(word)`

tokenized.data.unigram <- analysis.data %>% tidytext::unnest_tokens(word, transcription, to_lower=TRUE)

tokenized.data <- analysis.data %>% tidytext::unnest_tokens(ngram, transcription, token = "ngrams", n=2, to_lower = TRUE)

2

###Unique Tokens per Speciality

tokenized.data.unigram %>% dplyr::group_by(medical_specialty) %>% dplyr::distinct(word) %>% dplyr::summarise(n=dplyr::n())

##Unique Unigrams

##There are 7682 unique unigrams in the orthopedic speciality.

##There are 5935 unique unigrams in the radiology speciality.

##There are 11977 unique unigrams in the surgery speciality.

tokenized.data %>% dplyr::group_by(medical_specialty) %>% dplyr::distinct(ngram) %>% dplyr::summarise(n=dplyr::n())

word_counts <- tokenized.data.unigram %>%
    group_by(word) %>%
    summarise(count = n()) %>%
    ungroup() %>%
    arrange(desc(count))

count_distribution <- word_counts %>%
  group_by(count) %>%
  summarise(num_words = n()) %>%
  ungroup()
 
 ggplot2::ggplot(count_distribution, aes(x = count, y = num_words)) +
  geom_point() +
  labs(title = "Scatter Plot of Count Distribution",
       x = "Count of Unique Words",
       y = "Number of Words")

word_counts <- tokenized.data %>%
    group_by(ngram) %>%
    summarise(count = n()) %>%
    ungroup() %>%
    arrange(desc(count))

count_distribution <- word_counts %>%
  group_by(count) %>%
  summarise(num_words = n()) %>%
  ungroup()
 
 ggplot2::ggplot(count_distribution, aes(x = count, y = num_words)) +
  geom_point() +
  labs(title = "Scatter Plot of Count Distribution",
       x = "Count of Unique Bigrams",
       y = "Number of Words")

3 ###Unique bigrams per category

tokenized.data %>% dplyr::group_by(medical_specialty) %>% dplyr::distinct(ngram) %>% dplyr::summarise(n=dplyr::n())

##Unique Bigrams

##There are 55732 unique bigrams in the orthopedic specialty.

##There are 28297 unique bigrams in the radiology speciality.

##There are 130404 unique bigrams in the surgey speciality.

4

##Unique Sentences

analysis.data <- filtered.data %>%
  unnest_tokens(sentence, transcription, token = "sentences") %>%
  mutate(sentence = str_replace_all(sentence, "[^[:alnum:]\\s]", "")) %>%
  filter(!str_detect(sentence, "[0-9]")) %>%
  cross_join(stop_words) %>%
  group_by(note_id) %>%
  summarise(transcription = paste(sentence, collapse = " ")) %>%
  left_join(select(filtered.data, -transcription), by = "note_id")

?cross_join

?str_detect

tokenized.data.sentence <- analysis.data %>% tidytext::unnest_tokens(ngram, transcription, token = "sentences", to_lower = TRUE)

tokenized.data.sentence %>%
  dplyr::group_by(medical_specialty) %>%
  dplyr::count(name = "n") %>%
  dplyr::ungroup()

##Unique Sentences

##There are 350 unique bigrams in the orthopedic specialty.

##There are 262 unique bigrams in the radiology speciality.

##There are 1085 unique bigrams in the surgey speciality.

###Words per Category

tokenized.data %>%
  dplyr::group_by(medical_specialty) %>%
  dplyr::count(ngram, sort = TRUE) %>%
  dplyr::top_n(5)

Selecting by n

5

##Use of a Lemmatizer

#A general purpose lemmatizer may not work well for medical data. This is because medical data contains highly specialized terms that require accurately trained methods to be trained to accurately token terms. Some specific issues include:

#a. Medical data usually contains specialized terms, drugs names, and jargon. Therefore, a general purpose tool may not have the knowledge of these terms and may not be proficient in accurately identfying the lemmas.

#b. Medical terms typically come from different parts of speech such as nouns, verbs, and adjectives. Since the process of lemmatizing requires mapping to generate correct lemmas, general purpose lemmas (which have not been trained on medical data) may not process the variations in medical speech effectively.

lemmatized.data <- tokenized.data %>% dplyr::mutate(lemma=textstem::lemmatize_words(ngram))

lemma.freq <- lemmatized.data %>% 
  dplyr::count(medical_specialty, lemma) %>%
  dplyr::group_by(medical_specialty) %>% 
  dplyr::mutate(proportion = n / sum(n)) %>%
  tidyr::pivot_wider(names_from = medical_specialty, values_from = proportion) %>%
  tidyr::pivot_longer(`Surgery`:`Radiology`,
               names_to = "medical_specialty", values_to = "proportion")

ggplot2::ggplot(lemma.freq, ggplot2::aes(x=proportion, 
                                         y=`Orthopedic`,
                                         color=abs(`Orthopedic` - proportion))) + 
  ggplot2::geom_abline(color="gray40", lty=2) +
  ggplot2::geom_jitter(alpha=0.1, size=2.5, width=0.3, height=0.3) +
  ggplot2::geom_text(ggplot2::aes(label=lemma), check_overlap=TRUE, vjust=1.5) +
  ggplot2::scale_x_log10(labels=scales::percent_format()) + 
  ggplot2::scale_y_log10(labels=scales::percent_format()) + 
  ggplot2::scale_color_gradient(limits=c(0, 0.001), low="darkslategray4", high="gray75") +
  ggplot2::facet_wrap(~medical_specialty, ncol = 2) +
  ggplot2::theme(legend.position="none") +
  ggplot2:: labs(y="Orthopedic", x = NULL)

6

##Analyzing relative proportions

#This plot visualizes the same relative proportion of lemmas in each speciality. Based on these specialties, I would not expect to see the exact same relative proportions. There are some differences in the relationship between orthopaedics and radiology, and orthopaedics and surgery:

#Orthopaedics and surgery are more likely to have a high degree of common lemmas. Both specialties are based on standard anatomical terms.

#Orthopaedics and radiology are less likely to have a high degree of common lemmas. There is definitely overlap however, radiology may refer more to the technique of medical imaging. Therefore, many of the anatomical terms, diagnoses, and treatments related to orthopaedics may be missed.

7

##Direct comparison of surgery and radiology

library(dplyr)
library(tidyr)
library(ggplot2)
library(textstem)

lemmatized.data <- tokenized.data %>% dplyr::mutate(lemma=textstem::lemmatize_words(ngram))

lemma.freq <- lemmatized.data %>% 
  dplyr::count(medical_specialty, lemma) %>%
  dplyr::group_by(medical_specialty) %>% 
  dplyr::mutate(proportion = n / sum(n)) %>%
  tidyr::pivot_wider(names_from = medical_specialty, values_from = proportion) %>%
  tidyr::pivot_longer(`Orthopedic`:`Radiology`,
               names_to = "medical_specialty", values_to = "proportion")

ggplot2::ggplot(lemma.freq, ggplot2::aes(x=proportion, 
                                         y=`Surgery`,
                                         color=abs(`Surgery` - proportion))) + 
  ggplot2::geom_abline(color="gray40", lty=2) +
  ggplot2::geom_jitter(alpha=0.1, size=2.5, width=0.3, height=0.3) +
  ggplot2::geom_text(ggplot2::aes(label=lemma), check_overlap=TRUE, vjust=1.5) +
  ggplot2::scale_x_log10(labels=scales::percent_format()) + 
  ggplot2::scale_y_log10(labels=scales::percent_format()) + 
  ggplot2::scale_color_gradient(limits=c(0, 0.001), low="darkslategray4", high="gray75") +
  ggplot2::facet_wrap(~medical_specialty, ncol = 2) +
  ggplot2::theme(legend.position="none") +
  ggplot2:: labs(y="Surgery", x = NULL)

###TF-IDF Normailization

lemma.counts <- lemmatized.data %>% dplyr::count(medical_specialty, lemma)
total.counts <- lemma.counts %>% 
                      dplyr::group_by(medical_specialty) %>% 
                      dplyr::summarise(total=sum(n))

all.counts <- dplyr::left_join(lemma.counts, total.counts)

Joining with `by = join_by(medical_specialty)`

all.counts.tfidf <- tidytext::bind_tf_idf(all.counts, lemma, medical_specialty, n) 

all.counts.tfidf %>% dplyr::group_by(medical_specialty) %>% dplyr::slice_max(order_by=tf_idf, n=10)

8 ##Stand out lemmas

#The lemmas that stand out in these lists are “admission”, “diagnosis”, “chief”, and “complaint. Orthopedics often includes admission and diagnosis of patients based on their presenting complaint, so a treatment modallity can be selected.

analysis.data %>% dplyr::select(medical_specialty, transcription) %>% dplyr::filter(stringr::str_detect(transcription, 'b.i.d')) %>% dplyr::slice(1)

9

##Extracting unusual top lemma

analysis.data %>% dplyr::select(medical_specialty, transcription) %>% dplyr::filter(stringr::str_detect(transcription, 'atv')) %>% dplyr::slice(1)